Purpose: Explore data at sub-daily temporal resolutions (e.g., 15-min and 1-hour time steps) and compare outputs to daily data.
Given that streamflow can change so quickly in small, headwater streams, are we missing a key part of the story by using flow data summarized as daily means? Using daily mean flow reduces the range of values, particularly at the upper end (i.e., high flows), and so we may be overlooking the g~G relationship at very high flows. (Note limited analysis of 15-min data as Montana and Wyoming data is collected at the hourly timescale).
Visualize 15-min and 1-hour data and note diversity in timing of peak flows during events; compare to daily data.
Use event pairing to explore the mean and variation in time lags between peak flows at Big G and little g’s; compare hourly and daily data
Fit basic wedge model to the 1-hour unaligned data…do the results change so much that we need to align time series when working with sub-daily data? Compare to daily data.
Explore use of dynamic time warping to align time series data
Data
Load data
Bring in site info and sub-daily data
Code
# site information and locations
siteinfo <- read_csv ("C:/Users/jbaldock/OneDrive - DOI/Documents/USGS/EcoDrought/EcoDrought Working/Data/EcoDrought_SiteInformation.csv" )
siteinfo_sp <- st_as_sf (siteinfo, coords = c ("long" , "lat" ), crs = 4326 )
mapview (siteinfo_sp, zcol = "designation" )
Code
# flow/yield (and temp) data
dat_sub <- read_csv ("C:/Users/jbaldock/OneDrive - DOI/Documents/USGS/EcoDrought/EcoDrought Working/Data/EcoDrought_FlowTempData_Raw_ECODandNWIS.csv" )
dat_little <- dat_sub %>%
filter (site_name %in% c ("West Brook Lower" , "Mitchell Brook" , "Jimmy Brook" , "Obear Brook Lower" , "West Brook Upper" , "West Brook Reservoir" , "Sanderson Brook" , "Avery Brook" , "West Whately Brook" )) %>%
select (site_name, datetime, flow, area_sqmi)
dat_big <- dat_sub %>% filter (site_name == "West Brook NWIS" ) %>% select (site_name, datetime, flow, area_sqmi)
Check time zones
Code
unique (tz (dat_little$ datetime))
Code
unique (tz (dat_big$ datetime))
Organize 15-min data
Code
dat_15min <- bind_rows (dat_little, dat_big) %>%
mutate (site_name = factor (site_name, levels = c ("West Brook Lower" , "Mitchell Brook" , "Jimmy Brook" , "Obear Brook Lower" , "West Brook Upper" , "West Brook Reservoir" , "Sanderson Brook" , "Avery Brook" , "West Whately Brook" , "West Brook NWIS" ))) %>%
mutate (flow_cms = flow* 0.02831683199881 , area_sqkm = area_sqmi* 2.58999 ) %>%
mutate (yield = flow_cms * 900 * (1 / (area_sqkm)) * (1 / 1000000 ) * 1000 )
head (dat_15min)
# A tibble: 6 × 7
site_name datetime flow area_sqmi flow_cms area_sqkm yield
<fct> <dttm> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Avery Brook 2020-02-20 05:00:00 5.37 2.83 0.152 7.34 0.0187
2 Avery Brook 2020-02-20 05:15:00 5.3 2.83 0.150 7.34 0.0184
3 Avery Brook 2020-02-20 05:30:00 5.17 2.83 0.146 7.34 0.0180
4 Avery Brook 2020-02-20 05:45:00 5.27 2.83 0.149 7.34 0.0183
5 Avery Brook 2020-02-20 06:00:00 5.3 2.83 0.150 7.34 0.0184
6 Avery Brook 2020-02-20 06:15:00 4.94 2.83 0.140 7.34 0.0172
Organize 1-hour data
Code
dat_1hr <- bind_rows (dat_little, dat_big) %>%
mutate (site_name = factor (site_name, levels = c ("West Brook Lower" , "Mitchell Brook" , "Jimmy Brook" , "Obear Brook Lower" , "West Brook Upper" , "West Brook Reservoir" , "Sanderson Brook" , "Avery Brook" , "West Whately Brook" , "West Brook NWIS" ))) %>%
filter (! is.na (flow)) %>%
mutate (datetime = floor_date (datetime, unit = "hour" )) %>%
group_by (site_name, datetime) %>%
summarise (flow = mean (flow), area_sqmi = unique (area_sqmi)) %>%
ungroup () %>%
mutate (flow_cms = flow* 0.02831683199881 , area_sqkm = area_sqmi* 2.58999 ) %>%
mutate (yield = flow_cms * 3600 * (1 / (area_sqkm)) * (1 / 1000000 ) * 1000 )
head (dat_1hr)
# A tibble: 6 × 7
site_name datetime flow area_sqmi flow_cms area_sqkm yield
<fct> <dttm> <dbl> <dbl> <dbl> <dbl> <dbl>
1 West Brook Lower 2020-01-01 05:00:00 9.5 8.51 0.269 22.0 0.0439
2 West Brook Lower 2020-01-01 06:00:00 9.18 8.51 0.260 22.0 0.0425
3 West Brook Lower 2020-01-01 07:00:00 8.94 8.51 0.253 22.0 0.0414
4 West Brook Lower 2020-01-01 08:00:00 8.99 8.51 0.255 22.0 0.0416
5 West Brook Lower 2020-01-01 09:00:00 8.67 8.51 0.245 22.0 0.0401
6 West Brook Lower 2020-01-01 10:00:00 8.56 8.51 0.242 22.0 0.0396
Load daily data
Code
dat_1day <- read_csv ("C:/Users/jbaldock/OneDrive - DOI/Documents/USGS/EcoDrought/EcoDrought Working/Data/EcoDrought_FlowTempData_DailyWeekly.csv" ) %>%
filter (site_name %in% c ("West Brook Lower" , "Mitchell Brook" , "Jimmy Brook" , "Obear Brook Lower" , "West Brook Upper" , "West Brook Reservoir" , "Sanderson Brook" , "Avery Brook" , "West Whately Brook" , "West Brook NWIS" )) %>%
mutate (site_name = factor (site_name, levels = c ("West Brook Lower" , "Mitchell Brook" , "Jimmy Brook" , "Obear Brook Lower" , "West Brook Upper" , "West Brook Reservoir" , "Sanderson Brook" , "Avery Brook" , "West Whately Brook" , "West Brook NWIS" )))
head (dat_1day)
# A tibble: 6 × 31
station_no site_name site_id basin subbasin region lat long elev_ft
<chr> <fct> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl>
1 01171000 Avery Brook AB West Brook West Bro… Mass 42.4 -72.7 699.
2 01171000 Avery Brook AB West Brook West Bro… Mass 42.4 -72.7 699.
3 01171000 Avery Brook AB West Brook West Bro… Mass 42.4 -72.7 699.
4 01171000 Avery Brook AB West Brook West Bro… Mass 42.4 -72.7 699.
5 01171000 Avery Brook AB West Brook West Bro… Mass 42.4 -72.7 699.
6 01171000 Avery Brook AB West Brook West Bro… Mass 42.4 -72.7 699.
# ℹ 22 more variables: area_sqmi <dbl>, designation <chr>, date <date>,
# DischargeReliability <dbl>, TempReliability <dbl>, flow_mean <dbl>,
# flow_min <dbl>, flow_max <dbl>, tempc_mean <dbl>, tempc_min <dbl>,
# tempc_max <dbl>, flow_mean_filled <dbl>, flow_mean_cms <dbl>,
# flow_mean_filled_cms <dbl>, area_sqkm <dbl>, Yield_mm <dbl>,
# Yield_filled_mm <dbl>, flow_mean_7 <dbl>, flow_mean_filled_7 <dbl>,
# tempc_mean_7 <dbl>, Yield_mm_7 <dbl>, Yield_filled_mm_7 <dbl>
View 15-min data
Plot 15 min time series data
Code
dat_15min %>% select (datetime, site_name, yield) %>% spread (key = site_name, value = yield) %>% dygraph () %>% dyRangeSelector () %>% dyAxis ("y" , label = "Yield (mm)" ) %>% dyOptions (colors = c (hcl.colors (9 , "Zissou 1" ), "black" )) %>% dyHighlight ()